home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / rxdsgn.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  4.1 KB  |  167 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RxDsgn;
  13.  
  14. {$I RX.INC}
  15.  
  16. interface
  17.  
  18. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, {$ENDIF} Classes, SysUtils,
  19.   RTLConsts, DesignIntf, DesignEditors, VCLEditors, Controls, Graphics, ExtCtrls, Menus, Forms;
  20.  
  21. type
  22. {$IFNDEF RX_D4}
  23.   IDesigner = TDesigner;
  24.   IFormDesigner = TFormDesigner;
  25. {$ENDIF}
  26.  
  27.  
  28. { TFilenameProperty }
  29.  
  30.   TFilenameProperty = class(TStringProperty)
  31.   protected
  32.     function GetFilter: string; virtual;
  33.   public
  34.     procedure Edit; override;
  35.     function GetAttributes: TPropertyAttributes; override;
  36.   end;
  37.  
  38. { TDirnameProperty }
  39.  
  40.   TDirnameProperty = class(TStringProperty)
  41.   public
  42.     procedure Edit; override;
  43.     function GetAttributes: TPropertyAttributes; override;
  44.   end;
  45.  
  46. { TProgressControlProperty }
  47.  
  48.   TProgressControlProperty = class(TComponentProperty)
  49.   private
  50.     FProc: TGetStrProc;
  51.     procedure CheckComponent(const AName: string);
  52.   public
  53.     procedure GetValues(Proc: TGetStrProc); override;
  54.   end;
  55.  
  56. { TRxDBStringProperty }
  57.  
  58.   TRxDBStringProperty = class(TStringProperty)
  59.   public
  60.     function GetAttributes: TPropertyAttributes; override;
  61.     procedure GetValueList(List: TStrings); virtual;
  62.     procedure GetValues(Proc: TGetStrProc); override;
  63.   end;
  64.  
  65. implementation
  66.  
  67. uses Consts, Dialogs, RxCConst, FileUtil, VclUtils, RxPrgrss;
  68.  
  69. { TFilenameProperty }
  70.  
  71. function TFilenameProperty.GetFilter: string;
  72. begin
  73.   Result := LoadStr(SDefaultFilter);
  74. end;
  75.  
  76. procedure TFilenameProperty.Edit;
  77. var
  78.   FileOpen: TOpenDialog;
  79. begin
  80.   FileOpen := TOpenDialog.Create(Application);
  81.   try
  82.     FileOpen.Filename := GetValue;
  83.     FileOpen.InitialDir := ExtractFilePath(FileOpen.Filename);
  84.     if (ExtractFileName(FileOpen.Filename) = '') or not
  85.       ValidFileName(ExtractFileName(FileOpen.Filename)) then
  86.       FileOpen.Filename := '';
  87.     FileOpen.Filter := GetFilter;
  88.     FileOpen.Options := FileOpen.Options + [ofHideReadOnly];
  89.     if FileOpen.Execute then SetValue(FileOpen.Filename);
  90.   finally
  91.     FileOpen.Free;
  92.   end;
  93. end;
  94.  
  95. function TFilenameProperty.GetAttributes: TPropertyAttributes;
  96. begin
  97.   Result := [paDialog {$IFDEF WIN32}, paRevertable {$ENDIF}];
  98. end;
  99.  
  100. { TDirnameProperty }
  101.  
  102. procedure TDirnameProperty.Edit;
  103. var
  104.   FolderName: string;
  105. begin
  106.   FolderName := GetValue;
  107.   if BrowseDirectory(FolderName, ResStr(SSelectDirCap), 0) then
  108.     SetValue(FolderName);
  109. end;
  110.  
  111. function TDirnameProperty.GetAttributes: TPropertyAttributes;
  112. begin
  113.   Result := [paDialog {$IFDEF WIN32}, paRevertable {$ENDIF}];
  114. end;
  115.  
  116. { TProgressControlProperty }
  117.  
  118. procedure TProgressControlProperty.CheckComponent(const AName: string);
  119. var
  120.   Component: TComponent;
  121. begin
  122. {$IFDEF WIN32}
  123.   Component := Designer.GetComponent(AName);
  124. {$ELSE}
  125.   Component := Designer.Form.FindComponent(AName);
  126. {$ENDIF}
  127.   if (Component <> nil) and (Component is TControl) and
  128.     SupportsProgressControl(TControl(Component)) and Assigned(FProc) then
  129.     FProc(AName);
  130. end;
  131.  
  132. procedure TProgressControlProperty.GetValues(Proc: TGetStrProc);
  133. begin
  134.   FProc := Proc;
  135.   try
  136.     inherited GetValues(CheckComponent);
  137.   finally
  138.     FProc := nil;
  139.   end;
  140. end;
  141.  
  142. { TRxDBStringProperty }
  143.  
  144. function TRxDBStringProperty.GetAttributes: TPropertyAttributes;
  145. begin
  146.   Result := [paValueList, paSortList, paMultiSelect];
  147. end;
  148.  
  149. procedure TRxDBStringProperty.GetValues(Proc: TGetStrProc);
  150. var
  151.   I: Integer;
  152.   Values: TStringList;
  153. begin
  154.   Values := TStringList.Create;
  155.   try
  156.     GetValueList(Values);
  157.     for I := 0 to Values.Count - 1 do Proc(Values[I]);
  158.   finally
  159.     Values.Free;
  160.   end;
  161. end;
  162.  
  163. procedure TRxDBStringProperty.GetValueList(List: TStrings);
  164. begin
  165. end;
  166.  
  167. end.